Otherware/Otherware_1_SB_Development.iso/mac/hypercar/xfcn/spttool.cpt/Support Tools eXternals 1.2.5/card_6056.txt

Text File | 1990-11-13 | 24KB | 660 lines

-- card: 6056 from stack: in.5
-- bmap block id: 2653
-- flags: 0000
-- background id: 3858
-- name: FilePath
----- HyperTalk script -----
on HideObjects
  hide cd btn "Try It!"
end HideObjects

on ShowObjects
  show cd btn "Try It!"
end ShowObjects


-- part 1 (button)
-- low flags: 00
-- high flags: A004
-- rect: left=60 top=177 right=213 bottom=191
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 1
-- font id: 0
-- text size: 12
-- style flags: 8192
-- line height: 16
-- part name: Try it!
----- HyperTalk script -----
on mouseUp
  put FilePath("STAK", "Which stack do YOU like?") into chosenOne
  if chosenOne = the value of word 2 of the long name of this stack then
    answer "Good choice!  I would have picked that one too!"
  else
    answer "Sorry, wrong answer!  Try again."
  end if
end mouseUp




-- part contents for background part 20
----- text -----
     FilePath displays a modified Standard File dialog, centered on the HyperCard window, to let the user choose a file.  It returns the full path name of the choosen file, or empty if the CANCEL button is choosen.

     In addition to the standard Eject, Drive, Select, and Cancel buttons, the XFCN displays the amount of free space on a volume.  Additionally you may supply a prompt string (in parameter two) which will be placed below the file list.

     Calling syntax : FilePath(fileType, <promptString>, <"noDialog:"errorGlobal>)
  FILETYPE: a four character file type signature
  PROMPTSTRING: a text string which will be displayed at the bottom of the dialog.

      As with all of our XCMDs and XFCNs, passing a single question mark (FilePath("?") in this case) returns the syntax for the external.  Passing an exclamation mark (FilePath("!")) returns the copyright information.

-- part contents for background part 38
----- text -----
18/50

-- part contents for background part 42
----- text -----
{ FileName() XFCN source listing}
{ This is an XFCN that brings up a custom standard file dialog to allow the user to select a filename.  It }
{  places an optional string below the file list, and comes up centered in HC's window, regardless of }
{  which monitor it is on. }
{}
{  Written by:  Anup Murarka    Eric Carlson    }
{        ALINK:  SKEPTIC    ALINK:  cyNic  }
{                  CIS:  76004,3356    }
{}
{        We are part of the Support Tools Development Group,  }
{        Apple Computer, Inc.  }
{}
{        please DO NOT contack Mac DTS for support of this code!  }
{}
{        please DO contact the authors for support of this code!  }
{}
{        Send comments, bug reports, requests to any of the above  }
{        E-mail addresses or to:}
{}
{              (one of us)          }
{              Apple Computer, Inc.    }
{              900 E. Hamilton, Ave.    }
{              Campbell, CA   95008    }
{              M/S 72-L          }
{}
{  Copyright:  © 1989, 1990 by Apple Computer, Inc., all rights reserved.  }
{}
{ written by  : Anup Murarka                                        }
{ AppleLink  : Skeptic                                            }
{ modification history                                             }
{       Date      Initials                  Comments                }
{       ----      ------    ------------------------------------------------------}
{    11/29/89  ec&akm    first written                              }
{    8/14/90        ec      recompiled with new libraries for Modal Dialog update  bug  }
{                      & A/UX correct path construction. Changed version to 1.1  }
{}
unit dummyUnit;

interface

  uses
    HyperXCMD;

  procedure main (paramPtr: XCmdPtr);

implementation


  procedure FileName (paramPtr: XCmdPtr);
  FORWARD;

  procedure main (paramPtr: XCmdPtr);
  begin
    FileName(paramPtr);
  end;

  const
    kSFSaveDisk = $214;        { Negative of current volume refnum [WORD]  }
    kApplScratch = $00000A78;
    kCurDirStore = $398;        { DirID of current directory [LONG]        }
    DITLSizeDiff = 30;

  type
    DITLItem = record
        itmHndl: handle;
        itmRect: rect;
        itmType: SignedByte;
        itmData: SignedByte;     { This is really only the length byte.  Data follows of variable length}
{    itmData is followed by the actual data.  See IM I-427}
      end;
    pDITLItem = ^DITLItem;
    hDITLItem = ^pDITLItem;

    ItemList = record
        dlgMaxIndex: integer;
        DITLItems: array[0..0] of DITLItem;
      end;
    pItemList = ^ItemList;
    hItemList = ^pItemList;

    integerPtr = ^integer;

  procedure reportToUser (paramPtr: XCmdPtr;
                  msgStr: str255);
{}
{ report something back to the user.  }
{ the last parameter (optional) to an external may contain }
 { "noDialog" or "noDialog:GlobalName".  GlobalName is the name }
 { of a HyperTalk global variable into which error messages will be }
 { placed.  we've decided to use this approach to avoid confusing }
{ an error message with a valid result being returned from an XFCN. }
{}
    var
      tempStr: str255;
  begin
{check the last param to see if the user requested that}
{ we suppress the error dialog }
    ZeroToPas(paramPtr, paramPtr^.params[paramPtr^.paramCount]^, tempStr);
    UprString(tempStr, true);
    if pos('NODIALOG', tempStr) = 0 then
  { no special error handling specified, throw up a dialog and return the error message }
      begin
        SendCardMessage(paramPtr, concat('answer "', msgStr, '"'));
        paramPtr^.returnValue := PasToZero(paramPtr, msgStr);
      end
    else if (pos(':', tempStr) > 0) then
  { requested global AND noDialog so we fill in the global and return empty }
      begin
        tempStr := copy(tempStr, pos(':', tempStr) + 1, length(tempStr));
                            { get the name of the HC global  to fill }
        SetGlobal(paramPtr, tempStr, PasToZero(paramPtr, msgStr));
                            { and fill it }
        paramPtr^.returnValue := PasToZero(paramPtr, '');  { return empty }
      end
    else
  { requested noDialog only so we return the error condition as the result }
      paramPtr^.returnValue := PasToZero(paramPtr, msgStr);
  end;  { procedure }

  function AskedForHelp (paramPtr: XCmdPtr;
                  syntaxMsg: Str255;
                  copyrightMsg: Str255): boolean;
{  check to see if the user sent a '?' or a '!' as }
{ the only parameter. if so we will respond with }
{ the calling syntax or the copyright/version info }
{ for this external }
{}
    var
      firstStr: str255;
  begin
    askedForHelp := false;
    if paramPtr^.paramCount = 1 then
      begin
        ZeroToPas(paramPtr, paramPtr^.params[1]^, firstStr);
          { what is the first param? }
        if firstStr = '?' then
          begin
            reportToUser(paramPtr, syntaxMsg);
            askedForHelp := true
          end  { asked for help }
        else if firstStr = '!' then
          begin
            reportToUser(paramPtr, copyRightMsg);
            askedForHelp := true
          end;  { asked for copyright info }
      end;  { one parameter passed }
  end;  { function }

  function PathNameFromDirID (dirID: longint;
                  vRefnum: integer;
                  var fullPathName: str255): OSErr;
{ build up a full path name given a directory id and an vol ref num.  this method isn't reccomended in general (see the }
{  various tech notes), but we use it in HC externals as HC uses exclusively full path names }
    var
      myCPB: CInfoPBRec;
      directoryName: str255;
      err: OSErr;
  begin
    fullPathName := '';
    with myCPB do
      begin
        ioNamePtr := @directoryName;
        ioDrParID := DirId;
      end;

    repeat
      with myCPB do
        begin
          ioVRefNum := vRefNum;
          ioFDirIndex := -1;
          ioDrDirID := myCPB.ioDrParID;
        end;
      err := PBGetCatInfo(@myCPB, FALSE);

      directoryName := concat(directoryName, ':');

{ pascal strings mustn't be longer than 255 chars, though a path name may, so check }
      if length(directoryName) + length(fullPathName) <= 255 then
        fullPathName := concat(directoryName, fullPathName)
      else
        myCPB.ioDrDirID := fsRtDirID;    { lazy persons way to jump out }

    until (myCPB.ioDrDirID = 2);
    PathNameFromDirID := err;
  end;

  function StrToRect (paramPtr: XCMDPtr;
                  rectStr: Str255): Rect;
{ convert a string, as from a callback or a passed parameter, to a rect }
    var
      where: Integer;
      tempRect: rect;
  begin
    where := POS(',', rectStr);
    tempRect.left := StrToNum(paramPtr, COPY(rectStr, 1, where - 1));
    DELETE(rectStr, 1, where);

    where := POS(',', rectStr);
    tempRect.top := StrToNum(paramPtr, COPY(rectStr, 1, where - 1));
    DELETE(rectStr, 1, where);

    where := POS(',', rectStr);
    tempRect.right := StrToNum(paramPtr, COPY(rectStr, 1, where - 1));
    DELETE(rectStr, 1, where);

    tempRect.bottom := StrToNum(ParamPtr, rectStr);

    strToRect := tempRect;
  end;

  function HCWindowRect (paramPtr: XCMDPtr): rect;
{ the rect of HC's card window, in GLOBAL coordinates }
    var
      theResult: Handle;
      rectStr: str255;
      theLength: INTEGER;
  begin
    rectStr := 'the rect of card window';
    theResult := EvalExpr(paramPtr, rectStr);
    if (theResult <> nil) and (paramPtr^.result = noErr) then
      ZeroToPas(paramPtr, theResult^, rectStr)
    else
      rectStr := '';
    if (theResult <> nil) then
      DisposHandle(theResult);
    HCWindowRect := StrToRect(paramPtr, rectStr);
  end;

  function GetScreenSize: rect;
  { we don't have access to quick draw globals, as they lie in HC's global space, but we can }
  { get the monitor size indirectly by checking the portBits field of the window manager port }
  { MacRevealed vol 3, pg 20 }
    var
      deskPort: GrafPtr;
      tempRect: rect;
  begin
    GetWMgrPort(deskPort);    { grab a pointer to the window manager port }
    if deskPort = nil then
      begin
        setRect(tempRect, 0, 0, 512, 342);
        GetScreenSize := tempRect;
      end
    else
      GetScreenSize := deskPort^.portBits.bounds;
  end;

  function monitorRect (aPoint: point): rect;
  { given a point, return the rect of the monitor that contains it.}
    const
      SysEnvVersion = 2;
    var
      currGDevice: GDHandle;
      gotTheMonitor: boolean;
      tempRect: rect;
      theSysEnv: SysEnvRec;
      envErr: OSErr;
  begin
    currGDevice := nil;
    envErr := SysEnvirons(SysEnvVersion, theSysEnv);
  {SysEnvirons Version is a constant in the interface section of this file}
    if theSysEnv.hasColorQD then    { only proceed if we have color QD }
      begin
        currGDevice := GetDeviceList;
        gotTheMonitor := false;    { haven't found the monitor yet }
        while (currGDevice <> nil) and not (gotTheMonitor) do
    { we assume that the point is in one of the graphic devices }
          begin
            if PtInRect(aPoint, currGDevice^^.gdRect) then
              begin
                monitorRect := currGDevice^^.gdRect;
                gotTheMonitor := true;
              end
            else    { get the next device in the list }
              currGDevice := currGDevice^^.gdNextGD;
          end;
        if currGDevice = nil then
          begin
            setRect(tempRect, 0, 0, 0, 0);
            monitorRect := tempRect;
          end;
      end
    else  {No Color QD}
      begin
        tempRect := GetScreenSize;
        if PtInRect(aPoint, tempRect) then
          monitorRect := tempRect
        else
          begin
            setRect(tempRect, 0, 0, 0, 0);
            monitorRect := tempRect;
          end;
      end;
  end;

  function CenterInHCWindow (paramPtr: XCMDPtr;
                  windowRect: rect): point;
    var
      where: point;
      window, screen, tempRect: rect;
      h, v: integer;
  begin
    window := HCWindowRect(paramPtr);    { the rect of card the window }
    screen := monitorRect(window.topLeft);
  { check to see the rect of the monitor containing the upper right corner of the card window }
    setRect(tempRect, 0, 0, 0, 0);
    if EqualRect(screen, tempRect) then
  { if '0,0,0,0' comes back then the upper right is off screen, check the upper left }
      begin
        setPt(where, window.right, window.top);
        screen := monitorRect(where);
      end;

    OffsetRect(windowRect, window.left - windowRect.left, window.top - windowRect.top);
  { zero the dlog rect onto the card window }
    h := ((window.right - window.left) - (windowRect.right - windowRect.left)) div 2;
    v := ((window.bottom - window.top) - (windowRect.bottom - windowRect.top)) div 2;
    OffSetRect(windowRect, h, v);

  { although it isn't possible to have BOTH upper corners off screen, check for an error. }
  { if we find one, use the default monitor rect }
    if EqualRect(screen, tempRect) then
      screen := GetScreenSize;

  { now center the rect in the card window }
    if not (PtInRect(windowRect.topLeft, screen) and PtInRect(windowRect.botRight, screen)) then
      begin    { make sure the dlog rect is fully visible on the screen }
        if windowRect.top < screen.top then
          OffSetRect(windowRect, 0, screen.top - windowRect.top + 10);
        if windowRect.bottom > screen.bottom then
          OffSetRect(windowRect, 0, screen.bottom - windowRect.bottom - 10);
        if windowRect.left < screen.left then
          OffSetRect(windowRect, screen.left - windowRect.left + 10, 0);
        if windowRect.right > screen.right then
          OffSetRect(windowRect, screen.right - windowRect.right - 10, 0);
      end;
    SetPt(where, windowRect.left, windowRect.top);
    CenterInHCWindow := where;
  end;

  function unSignedByte (SB: signedByte): integer;
    type
      twoSBAreAnInt = record
          case integer of
            0: (
                sbArray: array[0..1] of SignedByte
            );
            1: (
                Int: integer
            );
        end;
    var
      tempInt: twoSBAreAnInt;
  begin
    tempInt.Int := 0;
    tempInt.sbArray[1] := SB;
    unSignedByte := tempInt.int;
  end;

  function insertCommas (theNumber: str255): str255;
  { Procedure to insert commas every 3 numeric digits}
    var
      count, group: integer;
  begin
    group := 0;
    for count := length(theNumber) downto 1 do
      begin
        group := group + 1;
        if (group <> 3) or (count = 1) then
          cycle;
        insert(',', theNumber, count);
        group := 0;
      end;
    insertCommas := theNumber;
  end;

  procedure drawFreeSpace (theDialog: DialogPtr);
  { draw the amount of free space into the dialog, just above item #5, the eject button }
    var
      thePort: GrafPtr;
      oldFont, oldSize: integer;
      freeSpace: longint;
      freeStr: str255;
      PB: ParamBlockRec;
      strWidth: integer;
      volInfoErr: OSerr;
      eraseArea: rect;
      itemType, left: integer;
      itemHndl: handle;
      itemRect: rect;
  begin
    GetPort(thePort);
    if thePort <> nil then
      begin
        PB.iovRefNum := -(integerPtr(kSFSaveDisk)^);     { grab the VRefNum directly from lo mem}
        PB.ioVolIndex := 0;                         { use vRefNum only }
        PB.ioNamePtr := @freeStr;                   { VERY IMPORTANT!  Tell PBGetVInfo where to }
        volInfoErr := PBGetVInfo(@PB, false);           { put the vol name, even though we don't use it }

        if volInfoErr = noErr then
          begin
            FreeSpace := (PB.ioVAlBlkSiz * PB.ioVFrBlk) div 1024;       { Calc the free size}
            NumToString(FreeSpace, FreeStr);
            FreeStr := insertCommas(FreeStr);
          end
        else
          begin
            FreeStr := '????';         { If an error occured, show question marks}
          end;

        FreeStr := concat(FreeStr, 'k free');
        oldFont := thePort^.txFont;    { remember the old font }
        oldSize := thePort^.txSize;    { and the size }
        TextFont(3);            { set text to geneva }
        TextSize(9);            { 9 point }
        GetDItem(theDialog, 5, itemType, itemHndl, itemRect);         { Get the coordinates of the Eject button}
        with itemRect do
          setRect(eraseArea, itemRect.left - 5, itemRect.top - 11, itemRect.right + 5, itemRect.top);
        eraseRect(eraseArea);
        strWidth := StringWidth(FreeStr);
        left := ((itemRect.right - itemRect.left) div 2) + itemRect.left;
        MoveTo(left - (strWidth div 2), itemRect.top - 2);  { move the pen}
        DrawString(FreeStr);      { show em how much free space they have... }
        TextFont(oldFont);        { set font to the original }
        TextSize(oldSize);        { and the size }
      end;
  end;

{ΓÇóΓÇó PromptedSFGetFile ΓÇóΓÇó}

  function getStdDlgFilter (theDialog: DialogPtr;
                  var theEvent: eventRecord;
                  var itemHit: integer): boolean;
  { A dialog filter is usually unneeded for simple std. file stuff.  We use one here so that we can draw the}
  { freespace for the current volume.  The string is drawn not put as a static text item so that we can use a}
  { different font for the string.  Because we draw on an update event we must compensate for std file's bug}
  { which confuses update events meant for windows behind it.  Thus if we see an update event for someone }
  { elses window change the event to a NULL and tell ModalDialog that we've handled it. }
  begin
    getStdDlgFilter := false;  { Pass Standard File package handle all events}
    case theEvent.what of

      updateEvt:
        if DialogPtr(theEvent.message) <> theDialog then
          begin
            itemHit := 100;      { change the event to a NULL }
            getStdDlgFilter := true;  { tell Standard File package that we have handled it}
          end
        else
          drawFreeSpace(theDialog);  { update our free space indicator }

      otherwise       { a do nothing case}
    end;  {case}
  end;    {getFileDlgFilter}

  function PromptedGetDlgHook (item: Integer;
                  dlg: DialogPtr): Integer;
  { This is the routine that puts the prompt on the dialog}
  { The prompt is added as a static text item to the end of the DITL}

    procedure AppendDITL (theDialog: DialogPtr);
      var
        hDITL: hDITLItem;             { Handle to DITL being appended }
        hItems: hItemList;             { Handle to DLOGΓÇÖs item list }
        promptHndl: handle;      { Handle to the prompt }
        itemRect: Rect;
        promptLength: integer;
        error: OSerr;
    begin         { AppendDITL}
      BlockMove(POINTER(kApplScratch), @promptHndl, 4);       { The handle to our prompt was stored in APPLScratch}
      if promptHndl = nil then
        exit(AppendDITL);      { Exit since we don't need to change anything}
      promptLength := integer(GetHandleSize(promptHndl));

      SetPort(theDialog);
      with WindowPtr(theDialog)^.portRect do
        SizeWindow(WindowPtr(theDialog), right - left, bottom - top + DITLSizeDiff, TRUE);
    { shift the bottom of the window down for the new item}

      hDITL := hDITLItem(NewHandle(SizeOf(DITLItem) + promptLength));
      MoveHHI(handle(hDITL));
      HLock(handle(hDITL));
      SetRect(itemRect, 12, 191, 246, 223);      { rect for the stat text item}
      hDITL^^.itmHndl := promptHndl;
      hDITL^^.itmRect := itemRect;
      hDITL^^.itmType := SignedByte(statText);
      hDITL^^.itmData := SignedByte(promptLength);
      HLock(handle(promptHndl));
  { Copy our prompt onto the end of the DITLrec}
      blockmove(promptHndl^, pointer(ORD4(@hDITL^^.itmData) + 1), promptLength);
      HUnLock(handle(promptHndl));

      hItems := hItemList(DialogPeek(theDialog)^.items);
      error := HandAndHand(Handle(hDITL), Handle(hItems));
      hItems^^.dlgMaxIndex := hItems^^.dlgMaxIndex + 1;

      HUnlock(Handle(hDITL));
      DisposHandle(Handle(hDITL));
    end;                                          { AppendDITL }

  begin
    PromptedGetDlgHook := item;
    if (item = -1) then      { we get a call with -1 before the window is shown }
      AppendDITL(dlg);
  end;

  procedure PromptedSFGetFile (pt: point;
                  Prompt: str255;
                  fileFilter: procPtr;
                  typeCount: integer;
                  typeList: SFTypeList;
                  var reply: SFReply);
  { This is the routine that does all of the work.}
    var
      promptHndl: handle;
      savedApplScratch: LongInt;
      DLGHook: ProcPtr;
      oldPort: GrafPtr;
      errorCode: OSErr;
  begin
  { First we need to make sure the prompt is of even length and no longer than 240 chars}
    if length(prompt) > 240 then
      prompt := copy(prompt, 1, 240)
    else if odd(length(prompt)) then
      prompt := concat(prompt, ' ');

  { Now we need to save the handle to the prompt where our Dialog Hook routine can find it}
  { If the newString call doesn't work, we save the nil handle anyway so our routine knows it didn't work}
    errorCode := ptrToHand(@prompt[1], promptHndl, length(prompt));
    BlockMove(POINTER(kApplScratch), @savedApplScratch, 4);    { save the appl scratch }
    BlockMove(@promptHndl, POINTER(kApplScratch), 4);        { shove our prompt in }

    if promptHndl <> nil then                    { don't need to enlarge DITL if no prompt }
      DLGHook := @PromptedGetDlgHook             { use MyDlgHook }
    else
      DLGHook := ProcPtr(0);                    { effectively, weΓÇÖre passing NIL }

    GetPort(oldPort);  { Save anything that we might change}

    SFPGetFile(pt, '', fileFilter, typeCount, TypeList, DLGHook, reply, getdlgID, @getStdDlgFilter);
          { have ΓÇÖem pick a file }

    SetPort(oldPort);  { and restore anything that we might change}

    BlockMove(@savedApplScratch, POINTER(kApplScratch), 4);    { restore the contents of ApplScratch!!!!! }
  end;

  procedure FileName (paramPtr: XCMDPtr);
    const
      DITLSizeDiff = 30;    { Room needed for the prompt}
    var
      reply: SFReply;
      pathName, prompt: str255;
      dlogHndl: DialogTHndl;
      tempRect: rect;
      thePt: point;
      theType: SFTypeList;
      typeCount: integer;
      err: OSErr;
  begin
  { First check to see if the user requested syntax or copyright information}
  { If they did, we exit the XFCN.  The subroutine takes care of returning the proper string}
    if askedForHelp(paramPtr, 'FilePath(<fileType>, <promptString>)', 'v1.1, ©1989, 1990 Apple Computer, Inc. by Anup Murarka & Eric Carlson') then
      exit(FileName);

    typeCount := -1;                              { assume they don't want any specific types shown }
    if paramPtr^.paramCount >= 1 then
      begin
        ZeroToPas(paramPtr, paramPtr^.params[1]^, prompt);    { borrow prompt var for file type }
        if prompt <> '' then
          begin
            BlockMove(Ptr(ord4(@prompt) + 1), @theType[0], 4);    { remember the file type }
            typeCount := 1;                                  { show only this type }
          end;
      end;

    if paramPtr^.paramCount > 1 then
      ZeroToPas(paramPtr, paramPtr^.params[2]^, prompt)
    else
      prompt := '';          { No default prompt}

  { do the calculations to center it in the HC window }
    dlogHndl := DialogTHndl(GetResource('DLOG', getDlgID));
    if dlogHndl <> nil then
      with dlogHndl^^.boundsRect do
        SetRect(tempRect, left, top, right, bottom + DITLSizeDiff)
    else
      SetRect(tempRect, 0, 0, 200, 348);
    thePt := CenterInHCWindow(paramPtr, tempRect);

    PromptedSFGetFile(thePt, prompt, nil, typeCount, theType, reply);
  { this routine is in customSF.p and does all of the real work for us.}
    if reply.good then                      { If a file was selected, return the pathname}
      begin
        err := PathNameFromDirID(integerPtr(kCurDirStore)^, reply.vRefNum, pathName);
        if err = noErr then
          begin
            pathName := concat(pathName, reply.fName);
            paramPtr^.returnValue := PasToZero(paramPtr, pathName);
          end;
      end;
  end;
end.